VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsPlugins"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'-----------------------------------------------------------------
'             PT DC Hub @ Direct Connect P2P Network
'-----------------------------------------------------------------
'       Developer: Carlos.DF (fLaSh) - Portugal
'          E-mail: carlosferreiracarlos@hotmail.com
' Project started: 10 - September - 2006
'         License: GNU General Public License.
'-----------------------------------------------------------------
'       Thanks to developers and contributores of SDCH/DDCH
'         The Left Hand, ButterflySoul, HaArD and Selyb
'  TheNOP, RollTheDice, JDommi, GhOstFaCE, ArchaicLight and TUFF
'-----------------------------------------------------------------
Option Explicit

Public Sub InstallPlugins(Optional ByVal blnForceInstall As Boolean = False)
    '------------------------------------------------------------------
    'Purpose:   This Function Scan all DLL and TBL found in folder Plugins,
    '
    'Params:    none
    '
    'Returns:   none
    '
    '   Called by Sub Main (in begin of the aplication)
    '------------------------------------------------------------------
10:    On Error GoTo Err
11:    Dim strFiles()    As String
12:    Dim strFileTitle  As String
13:    Dim strTblFile    As String
14:    Dim strPlgServ    As String
15:    Dim intLoop       As Integer
16:    Dim intIndex      As Integer
17:    Dim blnPlgError   As Boolean
    
19:    Erase g_objPlugin
20:    ReDim g_objPlugin(0)

22:    If DEBUG_MODE Then
23:        blnForceInstall = True
24:    End If

       'Get dll files to array
27:    strFiles = g_objFileAccess.ListFiles(G_APPPATH & "\Plugins\*.dll")
    
       'Check if is empty the array..
30:    If IsNothingArray(strFiles) Then
31:        g_PluginsFound = False: Exit Sub
32:    End If

       'Loop in array..
35:    For intLoop = LBound(strFiles) To UBound(strFiles)
           'Get dll file title
37:        strFileTitle = g_objFileAccess.GetFileTitle(strFiles(intLoop))
           'Plguin server is dll_filename + .Main
39:        strPlgServ = strFileTitle & ".Main"
           'Check if the plugin is already installed..
41:        If (Not AlreadyInstalled(strPlgServ)) Or (blnForceInstall) Then
               'Check if tbl file (Type Lib) is found..
               'This file is generated when creating plugins in .NET
44:            strTblFile = strFileTitle & ".tlb"
45:            If g_objFileAccess.FileExists(G_APPPATH & "\Plugins\" & strTblFile) Then
46:                If Not g_objActiveX.RegisterTBL(G_APPPATH & "\Plugins\" & strTblFile) Then
47:                    AddLog "There was an error loading the Plugin:" & strFiles(intLoop) & " (with tbl)"
48:                    GoTo NextLoop
49:                Else
50:                    AddLog "Plugin " & strFiles(intLoop) & " (with tbl) installed with success."
51:                End If
52:            Else
53:                If Not g_objActiveX.RegisterActiveX(G_APPPATH & "\Plugins\" & strFiles(intLoop), Register) Then
54:                    AddLog "There was an error loading the Plugin:" & strFiles(intLoop)
55:                    GoTo NextLoop
56:                Else
57:                    AddLog "Plugin " & strFiles(intLoop) & " installed with success."
58:                End If
59:            End If
60:        End If
        
62:        If Not g_objPlugin(0).Object Is Nothing Then
63:            ReDim Preserve g_objPlugin(UBound(g_objPlugin) + 1)
64:        End If
        
           'Set array index
67:        intIndex = UBound(g_objPlugin)
        
          'Turn var to false the possible error at loading the dll
70:        blnPlgError = False
         
           'Just case..
73:        On Error Resume Next
           'Create object ref..
75:        Set g_objPlugin(intIndex).Object = CreateObject(strPlgServ)
        
77:        If Not Err.Number Then
78:             g_objPlugin(intIndex).Name = g_objPlugin(intIndex).Object.Name
79:             g_objPlugin(intIndex).Version = g_objPlugin(intIndex).Object.Version
80:             g_objPlugin(intIndex).Author = g_objPlugin(intIndex).Object.Author
81:             g_objPlugin(intIndex).Description = g_objPlugin(intIndex).Object.Description
82:             g_objPlugin(intIndex).ReleaseDate = g_objPlugin(intIndex).Object.ReleaseDate
83:             g_objPlugin(intIndex).Comments = g_objPlugin(intIndex).Object.Comments
84:             g_objPlugin(intIndex).UseSetup = g_objPlugin(intIndex).Object.UseSetup
85:             g_objPlugin(intIndex).Index = intIndex
86:             g_objPlugin(intIndex).Object.Index = intIndex
87:        End If
           
           'Check if plugin has been loaded
90:        If Err.Number Then
91:            AddLog "There was an error creating the Plugin object: " & strFiles(intLoop) & " (" & Erl & ")"
92:            blnPlgError = True
93:            Err.Clear
94:        Else 'Set link objects
95:            If Not g_objPlugin(intIndex).Object.LoadPlug = 1 Or _
                  Not g_objPlugin(intIndex).Object.Ini(frmHub) Then
97:                 AddLog "There was an error creating link objects: " & strFiles(intLoop)
98:                 blnPlgError = True
99:           End If
100:       End If
        
102:       On Error GoTo Err
        
104:       If blnPlgError Then
105:            If UBound(g_objPlugin) > 0 Then
106:                ReDim Preserve g_objPlugin(UBound(g_objPlugin) - 1)
107:            Else
108:                Set g_objPlugin(0).Object = Nothing
109:            End If
110:       Else
111:            AddLog "Plugin " & strFiles(intLoop) & " loaded with success."
112:            g_PluginsFound = True
113:       End If
114:
NextLoop:
115:       DoEvents
        
117:   Next

119:   Exit Sub
120:
Err:
       'In case of mistake it cancels all plugins!!
122:   g_PluginsFound = False
123:   Erase g_objPlugin
124:   HandleError Err.Number, Err.Description, Erl & "|" & "clsPlugins.InstallPlugins()"
End Sub

Private Function AlreadyInstalled(ByVal strPlgServ As String) As Boolean
1:    Dim objPlugin   As Object
2:    Dim strTemp     As String
3:    On Error GoTo Err
    
5:    Set objPlugin = CreateObject(strPlgServ)
    
7:    strTemp = objPlugin.Name
    
9:    Set objPlugin = Nothing
    
11:   AlreadyInstalled = True

13:   Exit Function
14:
Err:
15:   AlreadyInstalled = False
End Function

Private Function IsNothingArray(sArray() As String) As Boolean
1:    Dim strTmp As String
2:    On Error GoTo Err
3:    strTmp = sArray(0)
4:    IsNothingArray = False
5:    Exit Function
Err:
6:    IsNothingArray = True
End Function
